home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / src-zelk / fortest.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-10-17  |  4.8 KB  |  161 lines
  1. /* fortest.c zilla 24apr - test the foreign function interface
  2.  * This file is separate from forfunc.c so it can be compiled separately,
  3.  * e.g. with -xansi on sgis.
  4.  */
  5.  
  6. #undef TESTIT
  7. #ifdef TESTIT   /*%%%%%%%%%%%%%%%% TESTSECTION %%%%%%%%%%%%%%%%*/
  8.  
  9. #include <theusual.h>
  10. #include <scheme.h>
  11.  
  12. static FILE *ftst = stdout;
  13.  
  14. void Define_Foreign Zproto((char *,vfunction *,char *));
  15.  
  16. #define ZTESTLOG    Define_Foreign("Ztestlog",(vfunction *)testlog,"RP");
  17. static FILE *testlog() 
  18. {
  19.   char hostname[256];
  20.   gethostname(hostname,256);
  21.   ftst = fopen("FOREIGNTST.LOG","w");
  22.   fprintf(ftst,";test of foreign function on %s on %s\n",
  23.           hostname,Ztimestring(Zcurtime()));
  24.   return ftst;
  25. }
  26.  
  27. #define ZNOARGS   Define_Foreign("Znoargs",(vfunction *)noargs,"");
  28. static void noargs() { int i = 3; fprintf(ftst,"Znoargs\n"); }
  29.  
  30. #define ZGETBOOL        Define_Foreign("Zgetbool",(vfunction *)getbool,"B");
  31. static void getbool(i) int i; { fprintf(ftst,"Zgetbool: %d\n",i); }
  32.  
  33. #define ZRTNBOOL  Define_Foreign("Zrtnbool",(vfunction *)rtnbool,"BRB");
  34. static bool rtnbool(i) int i; { fprintf(ftst,"Zrtnbool: %d\n",i); return i; }
  35.  
  36. #define ZGETINT  Define_Foreign("Zgetint",(vfunction *)getint,"I"); 
  37. static void getint(i) int i; {  fprintf(ftst,"Zgetint: %d\n",i); }
  38.  
  39. #define ZGETDBL  Define_Foreign("Zgetdbl",(vfunction *)getdbl,"F");
  40. static void getdbl(f) double f; {  fprintf(ftst,"Zgetdbl: %f\n",f); }
  41.  
  42. #define ZGETFLT  Define_Foreign("Zgetflt",(vfunction *)getflt,"f");
  43. static void ZDECLARE1(getflt,float,f) {  fprintf(ftst,"Zgetflt: %f\n",f); }
  44.  
  45. #define ZF2F  Define_Foreign("Zf2f",(vfunction *)f2f,"ffRf");
  46. static float ZDECLARE2(f2f,float,f1,float,f2)
  47. {  fprintf(ftst,"Zf2f: %f %f\n",f1,f2); return f1+f2; }
  48.  
  49. #define ZD2D  Define_Foreign("Zd2d",(vfunction *)d2d,"FFRF");
  50. static double d2d(f1,f2) double f1; double f2;
  51. {  fprintf(ftst,"Zd2d: %f %f\n",f1,f2); return f1+f2; }
  52.  
  53. #define ZGETARR
  54. #ifdef NOTYET
  55. static void getarr(a,len) float a[]; int len;
  56. {  int i;
  57.    fprintf(ftst,"GETARR\n");
  58.    for( i=0; i < len; i++ ) fprintf(ftst,"%f ",a[i]);
  59.    fprintf(ftst,"\n(obtained len=%d, type=%d)\n",
  60.           farray_clength(a),farray_ctype(a));
  61. }
  62. #endif
  63.  
  64. #define ZRTNINT  Define_Foreign("Zrtnint",(vfunction *)rtnint,"RI");
  65. static int rtnint() { static int i = 133;  return ++i; }
  66.  
  67. #define ZSTRLEN Define_Foreign("Zstrlen",(vfunction *)zstrlen,"SRI");
  68. static int zstrlen(str) char *str;
  69. { fprintf(ftst,"Zstrlen: [%s]=%d\n",str,strlen(str));
  70.   return(strlen(str));
  71. }
  72.  
  73. #define ZIRS  Define_Foreign("Zirs",(vfunction *)zirs,"IRS");
  74. static char *zirs(i) int i;
  75. { static char s[32];
  76.   fprintf(ftst,"Zirs: %d\n",i);
  77.   str_cpy(s,"A string...");  return s; }
  78.  
  79. #define ZTWOI     Define_Foreign("Ztwoi",(vfunction *)twoi,"II");
  80. static void twoi(i1,i2)  int i1,i2;
  81. {  fprintf(ftst,"Ztwoi: %d %d \n",i1,i2); }
  82.  
  83. #define ZFIVEI    Define_Foreign("Zfivei",(vfunction *)fivei,"IIIII");
  84. static void fivei(i1,i2,i3,i4,i5)  int i1,i2,i3,i4,i5;
  85. {  fprintf(ftst,"Zfivei: %d %d %d %d %d\n",i1,i2,i3,i4,i5); }
  86.  
  87. #define ZIDIID Define_Foreign("Zidiid",(vfunction *)idiid,"IFIIFRF");
  88. static double idiid(i1,d,i4,i5,d2)  int i1,i4,i5; double d,d2;
  89. { fprintf(ftst,"Zidiid: %d %f %d %d %f\n",i1,d,i4,i5,d2);
  90.   return (13.131313); 
  91. }
  92.  
  93. #define ZIFFIF Define_Foreign("Ziffif",(vfunction *)iffif,"IffIfRf");
  94. static float ZDECLARE5(iffif,int,i1,float,d,float,d2,int,i5,float,d3)
  95. { fprintf(ftst,"Ziffif: %d %f %f %d %f\n",i1,d,d2,i5,d3);
  96.   return ((float)33333.131313); 
  97. }
  98.  
  99. /* see what happens when routine expects float and is passed double */
  100. #define ZIXXIX Define_Foreign("Zixxix",(vfunction *)ixxix,"IFFIFRF");
  101. static float ZDECLARE5(ixxix,int,i1,float,d,float,d2,int,i5,float,d3)
  102. { fprintf(ftst,"Zixxix: %d %f %f %d %f\n",i1,d,d2,i5,d3);
  103.   return ((float)33333.131313); 
  104. }
  105.  
  106. #define ZIDDID Define_Foreign("Ziddid",(vfunction *)iddid,"IFFIFRF");
  107. static double iddid(i1,d,d2,i5,d3)  int i1,i5; double d,d2,d3;
  108. { fprintf(ftst,"Ziddid: %d %f %f %d %f\n",i1,d,d2,i5,d3);
  109.   return ((double)33333.131313); 
  110. }
  111.  
  112. #define ZIIFF Define_Foreign("Ziiff",(vfunction *)iiff,"IIff");
  113. static void ZDECLARE4(iiff,int,i1,int,i2,float,d,float,d2)
  114. { fprintf(ftst,"Ziiff: %d %d %f %f\n",i1,i2,d,d2); }     
  115.  
  116. #define ZIIDD Define_Foreign("Ziidd",(vfunction *)iidd,"IIFF");
  117. static void iidd(i1,i2,d,d2) int i1,i2; double d,d2;
  118. { fprintf(ftst,"Ziidd: %d %d %lf %lf\n",i1,i2,d,d2); }     
  119.  
  120.  
  121. #define ZISIRI  Define_Foreign("Zisiri",(vfunction *)isiri,"ISIRI");
  122. static int isiri(i1,str,i2)
  123.   int i1,i2;
  124.   char *str;
  125. {
  126.   static int ii = 33;
  127.   fprintf(ftst,"Zisiri: %d %s %d\n",i1,str,i2);
  128.   return ++ii;
  129. }
  130. #endif /*TESTIT*/
  131.  
  132. void Init_forfunctest() {
  133.  
  134. #ifdef TESTIT
  135.   /* prelinked functions to test */
  136.   ZTESTLOG
  137.  
  138.   ZNOARGS
  139.   ZGETBOOL
  140.   ZRTNBOOL
  141.   ZSTRLEN
  142.   ZGETINT
  143.   ZGETDBL
  144.   ZGETFLT
  145.   ZF2F
  146.   ZD2D
  147.   ZGETARR
  148.   ZRTNINT
  149.   ZIRS
  150.   ZIDIID
  151.   ZIFFIF
  152.   ZIDDID
  153.   ZIXXIX
  154.   ZIIFF
  155.   ZIIDD
  156.   ZISIRI
  157.   ZFIVEI
  158.   ZTWOI
  159. #endif  /*TESTIT*/
  160. } /*Init_forfunctest*/
  161.